(in-package :gwee)

(defclass button-mixin ()
  ((pushed-p :initform nil :accessor button-pushed-p)))

(defgeneric button-highlight (button)
  (:method-combination progn :most-specific-last))
(defgeneric button-unhighlight (button)
  (:method-combination progn :most-specific-last))
(defgeneric button-clicked (button)
  (:method-combination progn :most-specific-last))

(defmethod button-highlight progn (button))
(defmethod button-unhighlight progn (button))
(defmethod button-clicked progn (button))

(defmethod mouse-press-event ((view button-mixin) button x y)
  (declare (ignore x y))
  (unless (disabled-p view)
    (setf (button-pushed-p view) t
          (view-needs-update-p view) t)
    (button-highlight view)
    (grab-mouse view)))

(defmethod mouse-release-event ((view button-mixin) button x y)
  (ungrab-mouse view)
  (when (button-pushed-p view)
    (setf (button-pushed-p view) nil
          (view-needs-update-p view) t)
    (button-unhighlight view)
    (button-clicked view)))

(defmethod mouse-motion-event ((view button-mixin) state x y rx ry)
  (when (and state
             (eq (first (top-mouse-grabs *top-view*)) view))
    (cond ((and (>= x (view-scroll-x view))
		(>= y (view-scroll-y view))
		(< x (+ (view-scroll-x view) (view-width view)))
		(< y (+ (view-scroll-y view) (view-height view)))
		(not (button-pushed-p view)))
	   (setf (button-pushed-p view) t
		 (view-needs-update-p view) t)
           (button-highlight view))
	  ((and (or (< x (view-scroll-x view))
		    (< y (view-scroll-y view))
		    (>= x (+ (view-scroll-x view) (view-width view)))
		    (>= y (+ (view-scroll-y view) (view-height view))))
		(button-pushed-p view))
	   (setf (button-pushed-p view) nil
		 (view-needs-update-p view) t)
           (button-unhighlight view)))))

(defstruct image-cache
  normal pushed disabled)

(defclass button (widget button-mixin callback-mixin data-mixin foreground-mixin offset-mixin)
  ((normal-image :accessor button-normal-image)
   (pushed-image :accessor button-pushed-image)
   (disabled-image :accessor button-disabled-image)
   (checksum :initform nil)
   ;; widget data
   (image-cache :initform (make-hash-table :test 'equal) :allocation :class)
   (top-left-image :allocation :class)
   (top-left-selected-image :allocation :class)
   (top-right-image :allocation :class)
   (top-right-selected-image :allocation :class)
   (bottom-left-image :allocation :class)
   (bottom-left-selected-image :allocation :class)
   (bottom-right-image :allocation :class)
   (bottom-right-selected-image :allocation :class))
  (:default-initargs
   :foreground (gray 0)
    :width :minimum
    :height :minimum))

(defmethod print-object ((obj button) stream)
  (print-unreadable-object (obj stream :type t :identity t)
    (with-slots (data x y width height) obj
      (format stream "~s ~d ~d ~d ~d" data x y width height))))

(defun clear-button-cache ()
  (clrhash (slot-value (allocate-instance (find-class 'button)) 'image-cache)))

(defmethod format-data :around ((view button) &optional (data (view-data view)))
  (let* ((raw (or (call-next-method) ""))
         (data (if (listp raw) raw (list raw))))
    data))

(defmethod synchronize-width-minimum ((view button) (parent view) width height)
  (let* ((data (format-data view)))
    (+ (max (loop for i in data
               maximize (sdl:get-font-size i
                                           :size :w
                                           :font (view-font view)))
            15)
       33)))

(defmethod synchronize-height-minimum ((view button) (parent view) width height)
  (let* ((data (format-data view)))
    (+ (max (* (sdl:get-font-height :font (view-font view))
               (length data))
            20)
       3)))

(defun init-button ()
  (labels ((loadit (img)
             (sdl:load-and-convert-image (relative-pathname img))))
    (let ((class (allocate-instance (find-class 'button))))
      (with-slots (top-left-image
                   top-left-selected-image
                   top-right-image
                   top-right-selected-image
                   bottom-left-image
                   bottom-left-selected-image
                   bottom-right-image
                   bottom-right-selected-image)
          class
        (setf top-left-image              (loadit "button-top-left.png")
              top-left-selected-image     (loadit "button-top-left-selected.png")
              top-right-image             (loadit "button-top-right.png")
              top-right-selected-image    (loadit "button-top-right-selected.png")
              bottom-left-image           (loadit "button-bottom-left.png")
              bottom-left-selected-image  (loadit "button-bottom-left-selected.png")
              bottom-right-image          (loadit "button-bottom-right.png")
              bottom-right-selected-image (loadit "button-bottom-right-selected.png"))))))

(defun get-button-checksum (pane)
  (list (view-height pane)
        (view-width pane)
        (format-data pane)
        (vertical-offset pane)
        (horizontal-offset pane)
        (sdl:get-font-height :font (view-font pane))
        (sdl:get-font-face-family-name :font (view-font pane))))

(defmethod draw-view ((view button))
  (let* ((sel (button-pushed-p view))
         (checksum (get-button-checksum view)))
    (unless (equal checksum (slot-value view 'checksum))
      (update-button-cache view))
    (multiple-value-bind (x y) (translate-coordinates 0 0 view)
      (sdl:draw-surface-at-* (if (disabled-p view)
                                 (button-disabled-image view)
                                 (if sel
                                     (button-pushed-image view)
                                     (button-normal-image view)))
                             x y))))

(defun update-button-cache-surface (view state &aux (surface (sdl:create-surface (view-width view) (view-height view))))
  (labels ((rgb (r g b)
             (sdl:color :r r :g g :b b)))
    ;; sides
    (labels ((vline (x color)
               (sdl:draw-vline x 0 (view-height view)
                               :surface surface
                               :color color)))
      (loop for x from 0
         for c in (if (eq state :selected)
                      (list (rgb 102 102 114) (rgb 40 122 210)
                            (rgb 78 147 217) (rgb 95 157 221)
                            (rgb 98 161 224) (rgb 110 168 230)
                            (rgb 114 173 235) (rgb 116 177 237))
                      (list (rgb 107 107 107) (rgb 201 201 201)
                            (rgb 205 205 205) (rgb 206 206 206)
                            (rgb 208 208 208) (rgb 212 212 212)
                            (rgb 217 217 217) (rgb 218 218 218))) do
         (vline x c))
      (loop for x downfrom (1- (view-width view))
         for c in (if (eq state :selected)
                      (list (rgb 102 102 114) (rgb 40 122 210)
                            (rgb 78 147 217) (rgb 95 157 221)
                            (rgb 98 161 224) (rgb 110 168 230)
                            (rgb 114 173 235) (rgb 116 177 237)
                            (rgb 115 176 240) (rgb 120 180 242)
                            (rgb 123 182 243))
                      (list (rgb 107 107 107) (rgb 201 201 201)
                            (rgb 205 205 205) (rgb 206 206 206)
                            (rgb 208 208 208) (rgb 212 212 212)
                            (rgb 217 217 217) (rgb 218 218 218)
                            (rgb 220 220 220) (rgb 222 222 222)
                            (rgb 223 223 223))) do
         (vline x c)))
    (labels ((hline (y color)
               (sdl:draw-hline 0 (view-width view) y 
                               :surface surface
                               :color color)))
      (loop for y from 0
         for c in (if (eq state :selected)
                      (list (rgb  41  41 156) (rgb 200 213 237)
                            (rgb 187 210 236) (rgb 176 205 234)
                            (rgb 166 199 232) (rgb 159 195 232)
                            (rgb 154 193 233) (rgb 152 193 236)
                            (rgb 151 194 238))
                      (list (rgb 98 98 98) (rgb 249 249 249)
                            (rgb 244 244 244) (rgb 241 241 241)
                            (rgb 238 238 238) (rgb 236 236 236)
                            (rgb 236 236 236) (rgb 236 236 236)
                            (rgb 237 237 237))) do
         (hline y c))
      (loop for y downfrom (1- (view-height view))
         for c in (if (eq state :selected)
                      (list (rgb 104 104 104)
                            (rgb 175 249 255)
                            (rgb 172 239 255)
                            (rgb 166 230 255)
                            (rgb 159 223 255)
                            (rgb 156 217 255)
                            (rgb 149 210 255)
                            (rgb 143 204 255)
                            (rgb 136 197 255)
                            (rgb 127 188 250))
                      (list (rgb 104 104 104)
                            (rgb 255 255 255)
                            (rgb 255 255 255)
                            (rgb 255 255 255)
                            (rgb 255 255 255)
                            (rgb 249 249 249)
                            (rgb 243 243 243)
                            (rgb 240 240 240)
                            (rgb 235 235 235)
                            (rgb 235 235 235))) do
         (hline y c)))
    ;; corners
    (sdl:draw-surface-at-* (slot-value view (if (eq state :selected) 'top-left-selected-image 'top-left-image)) 0 0 :surface surface)
    (sdl:draw-surface-at-* (slot-value view (if (eq state :selected) 'top-right-selected-image 'top-right-image))
                           (- (view-width view)
                              (sdl:width (slot-value view (if (eq state :selected) 'top-right-selected-image 'top-right-image))))
                           0
                           :surface surface)
    (sdl:draw-surface-at-* (slot-value view (if (eq state :selected) 'bottom-left-selected-image 'bottom-left-image))
                           0
                           (- (view-height view)
                              (sdl:height (slot-value view (if (eq state :selected) 'bottom-left-selected-image 'bottom-left-image))))
                           :surface surface)
    (sdl:draw-surface-at-* (slot-value view (if (eq state :selected) 'bottom-right-selected-image 'bottom-right-image))
                           (- (view-width view)
                              (sdl:width (slot-value view (if (eq state :selected) 'top-right-selected-image 'top-right-image))) -1)
                           (- (view-height view)
                              (sdl:height (slot-value view (if (eq state :selected) 'bottom-left-selected-image 'bottom-left-image))))
                           :surface surface)
    (sdl:draw-box-* 8 9 (- (view-width view) 18) (- (view-height view) 19)
                    :surface surface
                    :color (if (eq state :selected)
                               (sdl:color :r 119 :g 181 :b 244)
                               (sdl:color :r 223 :g 223 :b 223)))
    (loop with data = (format-data view)
          for i in data
          for y from (+ (truncate (- (view-height view)
                                     (* (sdl:get-font-height :font (view-font view))
                                        (length data)))
                                  2)
                        (vertical-offset view))
                by (sdl:get-font-height :font (view-font view))
          for x = (+ (truncate (- (view-width view)
                                   (sdl:get-font-size i :size :w :font (view-font view)))
                                2)
                      (horizontal-offset view))
          do (sdl:draw-string-blended-* i x y
                                        :color (if (eq state :disabled)
                                                   (sdl:color :r 200 :g 200 :b 200)
                                                   (foreground-color view))
                                        ;;(sdl:color :r 223 :g 223 :b 223)
                                        :surface surface
                                        :font (view-font view)))
    (let ((s (sdl:convert-surface :surface surface)))
      (setf (sdl:color-key-enabled-p s) t
	    (sdl:color-key s) (sdl:color :r 255 :g 0 :b 170))
      s)))


(defun update-button-cache (view)
  ;; check the global cache first
  (let* ((checksum (get-button-checksum view))
         (cache (gethash checksum (slot-value view 'image-cache))))
    (if cache
        (setf (button-normal-image view)   (image-cache-normal cache)
              (button-pushed-image view)   (image-cache-pushed cache)
              (button-disabled-image view) (image-cache-disabled cache))
        (setf (button-normal-image view)   (update-button-cache-surface view :normal)  
              (button-pushed-image view)   (update-button-cache-surface view :selected)
              (button-disabled-image view) (update-button-cache-surface view :disabled)
              ;; cache the result for future reference
              (gethash checksum (slot-value view 'image-cache))
              (make-image-cache :normal (button-normal-image view)
                                :pushed (button-pushed-image view)
                                :disabled (button-disabled-image view))))
    (setf (slot-value view 'checksum) checksum)))

(defmethod button-clicked progn ((view button))
  (when (click-callback view)
    (funcall (click-callback view) view)))
